perm filename DV.FIX[MF,ALS] blob sn#795705 filedate 1985-06-17 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	@p function read_ascii(p:integer):real
C00009 00003	@ @<Read ASCII number and express as a real value@>=
C00011 00004	function read_ascii(o:eight_bitsp,k:integer):real
C00013 00005	@p function read_ascii(p:integer):real
C00022 ENDMK
C⊗;
@p function read_ascii(p:integer):real;
var jj,kk:real;
negative:boolean;
begin
jj←0.0;
negative←false;
while (xxx_o=" ") and (xxx_k<p) do begin incr(xxx_k); xxx_o←get_byte; end;
if (xxx_o="-") and (xxx_k<p) then begin negative←true;
    incr(xxx_k); xxx_o←get_byte;
    end;
while (xxx_o≥"0") and (xxx_o≤"9") and (xxx_k≤p) do begin
    jj←jj*10+(xxx_o-"0"); incr(xxx_k); if xxx_k<p then xxx_o←get_byte;
    end;
if (xxx_o=".") and (xxx_k≤p) then
    begin
    incr(xxx_k); if xxx_k<p then xxx_o←get_byte; 
    kk←1.0;
    while (xxx_o≥"0") and (xxx_o≤"9") and (xxx_k≤p) do
	begin
        kk←kk*0.1; jj←jj+kk*(xxx_o-"0"); incr(xxx_k);
	if xxx_k<p then xxx_o←get_byte;
	end;
    end;
if negative then jj←-jj;
read_ascii←jj;
end;


from dvidov.sai
			case xcommand[1 for 1] of
				begin
				["p"] comment remember current position;
				    if equ(xcommand,"point") then
					begin integer pindex;
					rejectextension←FALSE;
					pindex←intscan(xcommandline,brchar);
					hcoord[pindex]←hh;
					vcoord[pindex]←vv;
					DEBUGONLY if (DEBUG land dvicommands) then
						print("[index=",pindex,
							" hh=",hh*pixtoprint,
							" vv=",vv*pixtoprint,"]");
					end;
				["m"] comment Move current position to point position;
				    if equ(xcommand,"moveto") then
					begin integer pindex;
					rejectextension←FALSE;
					if not nomwarn then
						warn(""""&"moveto"&""""&
						" commands are not standard TeX extensions");
					nomwarn←true;
					pindex←intscan(xcommandline,brchar);
					h ← (hh←hcoord[pindex])/pconv + .5;
					v ← (vv←vcoord[pindex])/pconv + .5;
					end;

				["j"] comment join points;
				    if equ(xcommand,"join") then
					begin integer vecfont,p1,p2;
					rejectextension←FALSE;
					vecfont←choosevecfont(realscan(xcommandline,brchar));
					p2←intscan(xcommandline,brchar);
					while scan(xcommandline,skipspaces,brchar) do
						begin
						p1←p2;
						p2←intscan(xcommandline,brchar);
						DEBUGONLY if (DEBUG land dvicommands) then
							print("[p1=",p1," p2=",p2,"]");
						outvector(hcoord[p1],vcoord[p1],hcoord[p2],vcoord[p2],vecfont);
						end;
					end;

				["r"]
				    if equ(xcommand,"rectangle") then
					begin integer p1,p2,lx,by,w,h,txre,pmod;
					rejectextension←FALSE;
					txre←intscan(xcommandline,brchar);
					scan(xcommandline,skipspaces,brchar);
					pmod←scan(xcommandline,oneword,brchar);
					if (pmod neq "o") then
					    warn("Replacing ""o"" for "&pmod
						&" in: rectangle "
						&cvs(txre)&" "&pmod&xcommandline);
					p1←intscan(xcommandline,brchar);
					p2←intscan(xcommandline,brchar);
					lx←hcoord[p1];
					by←vcoord[p1];
					w←hcoord[p2]-lx;
					h←by-vcoord[p2] # remember y grows downwards;
					if w<0 then
						begin
						w←-w;
						lx←lx-w;
						end;
					if h<0 then
						begin
						h←-h;
						by←by+h;
						end;
					DEBUGONLY if (DEBUG land dvicommands) then
						print("[p1=",p1," p2=",p2,"]");
					outrect(lx,by,w,h,txre,pmod);
					end;
				else begin end
				end;
see oc.web page 9 line 73

@ @<Read ASCII number and express as a real value@>=
begin
jj←0.0;
negative←false;
while (o=" ") and (k<p) do begin incr(k); o←get_byte; end;
if (o="-") and (k<p) then begin negative←true; incr(k); o←get_byte; end;
while (o≥"0") and (o≤"9") and (k<p) do begin
    jj←jj*10+(o-"0"); incr(k); o←get_byte;
@!debug
    print(xchr[o]);
gubed
    end;
if (o=".") and (k<p) then
    begin incr(k); o←get_byte;
@!debug
    print(xchr[o]);
gubed
    kk←1.0;
    while (o≥"0") and (o≤"9") and (k<p) do
	begin kk←kk*0.1;
	jj←jj+kk*(o-"0");
	incr(k); o←get_byte;
@!debug
	print(xchr[o]);
gubed
	end;
    if negative then jj←-jj;
    end;
end

function read_ascii(o:eight_bits;p,k:integer):real;
var jj,kk:real;
negative:boolean;
begin
jj←0.0;
negative←false;
while (o=" ") and (k<p) do begin incr(k); o←get_byte; end;
if (o="-") and (k<p) then begin negative←true; incr(k); o←get_byte; end;
while (o≥"0") and (o≤"9") and (k<p) do begin
    jj←jj*10+(o-"0"); incr(k); o←get_byte;
@!debug
    print(xchr[o]);
gubed
    end else jj←0.0;
if (o=".") and (k<p) then
    begin incr(k); o←get_byte; 
@!debug
    print(xchr[o]);
gubed
    kk←1.0;
    while (o≥"0") and (o≤"9") and (k<p) do
	begin kk←kk*0.1; jj←jj+kk*(o-"0"); incr(k); o←get_byte;
@!debug
	print(xchr[o]);
gubed
	end;
    if negative then jj←-jj;
    end;
cur_o_val←o;  cur_k_val←k;
read_ascii←jj;
end

@p function read_ascii(p:integer):real;
var jj,kk:real;
negative:boolean;
begin
jj←0.0;
negative←false;
while (xxx_o=" ") and (xxx_k<p) do begin incr(xxx_k); xxx_o←get_byte; end;
if (xxx_o="-") and (xxx_k<p) then begin negative←true; incr(xxx_k); xxx_o←get_byte; end;
while (xxx_o≥"0") and (xxx_o≤"9") and (xxx_k<p) do begin
    jj←jj*10+(xxx_o-"0"); incr(xxx_k); xxx_o←get_byte;
@!debug
    print(xchr[xxx_o]);
gubed
    end;
if (xxx_o=".") and (xxx_k<p) then
    begin incr(xxx_k); xxx_o←get_byte; 
@!debug
    print(xchr[xxx_o]);
gubed
    kk←1.0;
    while (xxx_o≥"0") and (xxx_o≤"9") and (xxx_k<p) do
	begin kk←kk*0.1; jj←jj+kk*(xxx_o-"0"); incr(xxx_k); xxx_o←get_byte;
@!debug
	print(xchr[xxx_o]);
gubed
	end;
    if negative then jj←-jj;
    end;
read_ascii←jj;
end;
@#
procedure do_point(p:integer);
var k:integer; {loop variable}
o:eight_bits;
match:boolean; {does everything match}
begin if p<7 then for k←2 to p do o←get_byte else
    begin match←true;
    for k←2 to 6 do
	begin o←get_byte;
	if o≠xxx_point[k] then match←false;
@!debug
	print(xchr[o]);
gubed
	end;
    p_index←0;
    for k←7 to p do
	begin o←get_byte;
	if match then p_index←p_index*10+o-"0";
	end;
    if match then
	begin hh_point[p_index]←pixel_round(h);
 	vv_point[p_index]←pixel_round(v);
@!debug
print(p_index:1,' ',pixel_round(h):1,',',pixel_round(v):1);
gubed
	end;
    end;
end;
@#
procedure do_join(p:integer);
var k,q,r:integer;
pen_real:real; {the pen size as read}
jj,kk:real; {used in computing |pen_size|}
match:boolean; {does everything match}
begin if p<8 then for k←2 to p do xxx_o←get_byte else
    begin match←true;
    for k←2 to 5 do
	begin xxx_o←get_byte;
	if xxx_o≠xxx_join[k] then match←false;
@!debug
	print(xchr[xxx_o]);
gubed
	end;
    if not match then for k←6 to p do xxx_o←get_byte else
	begin xxx_o←get_byte;
@!debug
	print(xchr[xxx_o]);
gubed
	xxx_k←k;
	jj←read_ascii(p);
	pen_size←pixel_round(jj*65536.0);
	if pen_size>20 then pen_size←20 else if pen_size<0 then pen_size←0;
	im_byte(set_pen); im_byte(pen_size);
@!debug
	print('(',pen_size:1,')');
gubed
	vertex_count←1; q←0; incr(xxx_k);
	for k←xxx_k to p do begin
	    xxx_o←get_byte;
	    if (xxx_o≥"0") and (xxx_o≤"9") then q←q*10+xxx_o-"0" else
	    if xxx_o=" " then begin
@!debug
		print(' ',q:1);
gubed
		join_points[vertex_count]←q; incr(vertex_count); q←0;
		end;
	    end;
	join_points[vertex_count]←q;
@!debug
	print(' ',q:1);
	print(' [',im_byte_no:1,'] create_path ');
gubed
	im_byte(create_path);
	im_halfword(vertex_count);
@!debug
	print(' (',vertex_count:1,')');
gubed
	for q←1 to vertex_count do
	    begin im_halfword(hh_point[join_points[q]]);
	    im_halfword(vv_point[join_points[q]]);
@!debug
	    print(' ',hh_point[join_points[q]]:1);
	    print(',',vv_point[join_points[q]]:1);
gubed
	    end;
@!debug
	print(' [',im_byte_no:1,'] draw_path ');
gubed
	im_byte(draw_path); im_byte(15);
	end;
    end;
end;
@#

procedure do_circle(p:integer);
var k,q,r:integer; jj,kk:real;
negative:boolean; {is it a negative number?}
match:boolean; {does everything match}
begin if p<13 then for k←2 to p do xxx_o←get_byte else
    begin match←true;
    for k←2 to 7 do
	begin xxx_o←get_byte;
	if xxx_o≠xxx_circle[k] then match←false;
@!debug
gubed
	print(xchr[xxx_o]);
	end;
    if not match then for k←8 to p do xxx_o←get_byte else
	begin xxx_o←get_byte;
@!debug
gubed
	print(xchr[xxx_o]);
	xxx_k←8;
	jj←read_ascii(p);
	pen_size←pixel_round(jj*65536.0);
	if pen_size>20 then pen_size←20 else if pen_size<0 then pen_size←0;
	im_byte(set_pen); im_byte(pen_size);
	im_byte(circ_arc);
@!debug
gubed
	print('(',pen_size:1,')');
	jj←read_ascii(p);
	r←pixel_round(jj); im_halfword(r); {the radius}
	jj←read_ascii(p);
 	q←round(jj*16384/360);
	im_halfword(q); {first angle}
@!debug
gubed
	print('(',q:1,')');
	jj←read_ascii(p);
	r←round(jj*16384/360);
	if r=q then r←q+16383;{Imagen requires this to draw a complete circle}
	im_halfword(r); {second angle}
@!debug
gubed
	print('(',r:1,')');
	im_byte(draw_path); im_byte(15);
	end;
    end;
end;

@#
procedure do_ellipse(p:integer);
var k,q,r:integer; jj,kk:real;
negative:boolean; {is it a negative number?}
match:boolean; {does everything match}
begin if p<18 then for k←2 to p do xxx_o←get_byte else
    begin match←true;
    for k←2 to 8 do
	begin xxx_o←get_byte;
	if xxx_o≠xxx_circle[k] then match←false;
@!debug
gubed
	print(xchr[xxx_o]);
	end;
    if not match then for k←9 to p do xxx_o←get_byte else
	begin xxx_o←get_byte;
@!debug
gubed
	print(xchr[xxx_o]);
	xxx_k←9;
	jj←read_ascii(p);
	pen_size←pixel_round(jj*65536.0);
	if pen_size>20 then pen_size←20 else if pen_size<0 then pen_size←0;
	im_byte(set_pen); im_byte(pen_size);
	im_byte(circ_arc);
@!debug
gubed
	print('(',pen_size:1,')');
	jj←read_ascii(p);
	r←pixel_round(jj); im_halfword(r); {radiusa, originally on h axis}
   	jj←read_ascii(p);
	r←pixel_round(jj); im_halfword(r); {radiusb, originally on v axis}
	jj←read_ascii(p);
 	q←round(jj*16384/360);
	im_halfword(q); {alpha_offset, rotation of radiusa and radiusb}
	jj←read_ascii(p);
 	q←round(jj*16384/360);
	im_halfword(q); {first angle}
@!debug
gubed
	print('(',q:1,')');
	jj←read_ascii(p);
	r←round(jj*16384/360);
	if r=q then r←q+16383;{Imagen requires this to draw a complete circle}
	im_halfword(r); {second angle}
@!debug
gubed
	print('(',r:1,')');
	im_byte(draw_path); im_byte(15);
	end;
    end;
end;